home *** CD-ROM | disk | FTP | other *** search
Text File | 1988-04-23 | 4.9 KB | 186 lines | [TEXT/PJMM] |
- {**********************************************}
- { Put this file in the project after MacPasLib and MacTraps. }
- { Don't forget to "Use resource file" in "Run options" of menu "Project" }
- { This resource file may be empty, or may contain a copy of }
- { system file reources CDEF 0 and 1 }
- {**********************************************}
- PROGRAM Controls;
-
- CONST
- CDEFID = 1; { 0 for button, 1 for scroll bar }
-
- TYPE
- CDEFcodeHdl = ^CDEFcodePtr;
- CDEFcodePtr = ^CDEFcodeRecord;
- CDEFcodeRecord = RECORD
- jump : integer;
- address : ProcPtr;
- END;
-
- VAR
- boundsRect, TextRect : rect;
- myControl, whichControl : ControlHandle;
- theEvent : eventRecord;
- thePoint : point;
- whichPart : integer;
- theWindow, whichWindow : WindowPtr;
- myFakeCDEF : CDEFcodeHdl;
- myFakeCDEFid : integer;
- CDEFProcHandle : handle;
-
-
- LABEL
- 1, 2;
-
-
-
- FUNCTION DoCDEF (varCode : integer;
- theControl : ControlHandle;
- message : integer;
- param : longint;
- ProcHandle : handle) : longint;
- INLINE
- { CDEF relies on a prepared default value of 0 as function result : }
- $42AF, $0010, {CLR.L 10(A7)}
-
- { JSR to a procedure passed by handle as last argument }
- $205F, {MOVE.L (A7)+,A0}
- $2050, {MOVE.L (A0),A0}
- $4E90; {JSR (A0)}
-
-
-
- FUNCTION ControlProc (varCode : integer;
- theControl : ControlHandle;
- message : integer;
- param : longint) : longint;
- BEGIN
- writeln(' message= ', message, 'param= ', param);
- ControlProc := DoCDEF(varCode, theControl, message, param, CDEFProcHandle);
- END;
-
-
-
- BEGIN
- { create a intermediate CDEF resource : }
- myFakeCDEF := CDEFcodeHdl(NewHandle(sizeof(CDEFcodeRecord)));
- IF MemError <> NoErr THEN
- GOTO 2;
- myFakeCDEF^^.jump := $4EF9;
- myFakeCDEF^^.address := @ControlProc;
-
- REPEAT
- myFakeCDEFid := UniqueID('CDEF');
- { in order to have 16*myFakeCDEFid < maxint : }
- UNTIL myFakeCDEFid < 1000;
-
- AddResource(handle(myFakeCDEF), 'CDEF', myFakeCDEFid, '');
- IF ResError <> NoErr THEN
- GOTO 2;
-
- SetRect(TextRect, 250, 40, 500, 330);
- SetTextRect(TextRect);
- ShowText;
- SetRect(boundsRect, 40, 40, 200, 200);
- theWindow := NewWindow(NIL, boundsrect, 'my window', true, 0, pointer(-1), false, 0);
- SetPort(theWindow);
- CDEFProcHandle := GetResource('CDEF', CDEFID);
- IF ResError <> NoErr THEN
- GOTO 1;
- HLock(CDEFProcHandle);
- IF MemError <> NoErr THEN
- GOTO 1;
- SetRect(boundsRect, 10, 10, 90, 26);
-
- { now we begin to test the Control Manager's routines : }
-
- writeln('NewControl : ');
- myControl := NewControl(thePort, boundsRect, 'my control', true, 0, 0, 48, myFakeCDEFid * 16, 0);
- SetCtlAction(myControl, pointer(-1));
- writeln('SetCTitle : ');
- SetCTitle(myControl, 'new name');
- writeln('HideControl : ');
- HideControl(myControl);
- writeln('ShowControl : ');
- ShowControl(myControl);
- writeln('HiliteControl : ');
- HiliteControl(myControl, 1);
- writeln('HiliteControl : ');
- HiliteControl(myControl, 255);
- writeln('HiliteControl : ');
- HiliteControl(myControl, 0);
-
- writeln('SetCtlValue : ');
- SetCtlValue(myControl, 1);
- writeln('SetCtlMax : ');
- SetCtlMax(myControl, 0);
- writeln('SetCtlMax : ');
- SetCtlMax(myControl, 1);
- writeln('SetCtlMin : ');
- SetCtlMin(myControl, 1);
- writeln('SetCtlMin : ');
- SetCtlMin(myControl, 0);
- writeln('SetCtlValue : ');
- SetCtlValue(myControl, 0);
-
- writeln('MoveControl : ');
- MoveControl(myControl, 20, 20);
- writeln('SizeControl : ');
- SizeControl(myControl, 100, 30);
-
- { let's have a loop to test "TrackControl" (and "FindControl") : }
- writeln('The user should try actions on the control.');
- writeln('End by clicking outside the control.');
- FlushEvents(EveryEvent, 0);
- InitCursor;
- REPEAT
- REPEAT
- UNTIL GetNextEvent(MDownMask, theEvent);
- thePoint := theEvent.where;
- whichPart := FindWindow(thePoint, whichWindow);
- SetPort(whichWindow);
- GlobalToLocal(thePoint);
- writeln('FindControl : ');
- whichPart := FindControl(thePoint, whichWindow, whichControl);
- IF whichControl <> NIL THEN
- BEGIN
- writeln('TrackControl : ');
- whichPart := TrackControl(whichControl, thePoint, pointer(-1));
- END;
- UNTIL whichControl = NIL;
-
- FlushEvents(MUpMask, 0);
- { let's have another loop to test "DragControl" (and "FindControl") : }
- writeln('The user should try to drag the control.');
- writeln('End by clicking outside the control.');
- REPEAT
- REPEAT
- UNTIL GetNextEvent(MDownMask, theEvent);
- thePoint := theEvent.where;
- whichPart := FindWindow(thePoint, whichWindow);
- SetPort(whichWindow);
- GlobalToLocal(thePoint);
- writeln('FindControl : ');
- whichPart := FindControl(thePoint, whichWindow, whichControl);
- IF whichControl <> NIL THEN
- WITH whichWindow^ DO
- BEGIN
- writeln('DragControl : ');
- DragControl(whichControl, thePoint, PortRect, PortRect, noConstraint);
- END;
- UNTIL whichControl = NIL;
-
- writeln('DisposControl : ');
- DisposeControl(myControl);
- writeln('end');
-
- 1 :
- { let's remove our fake CDEF : }
- RmveResource(handle(myFakeCDEF));
- IF ResError <> NoErr THEN
- GOTO 2;
- DisposHandle(handle(myFakeCDEF));
-
- { error label : }
- 2 :
- END.